Unlike K-means algorithm, each data object is not the member of only one cluster but is the member of all clusters with varying degrees of memberhip between 0 and 1.
In our case , each data object belong to ONLY one cellular component nuclear, cytoplasm or membrane.
Conclusion: 1 - fcm and pfcm takes a lot of time if we use high image resolution 2 - k-means method seems to be more suitable.
im <- readImage("basales.jpg")
dim(im)
[1] 1024 768 3
plot(im) # raster method means within R

## I. reduce the size of image
# scale to a specific width and height
#ims <- resize(im, w = 200, h = 100)
# II. scale by 50%; the height is determined automatically so that
# the aspect ratio is preserved
ims <- resize(im, dim(im)[1]/8)
ims
Image
colorMode : Color
storage.mode : double
dim : 128 96 3
frames.total : 3
frames.render: 1
imageData(object)[1:5,1:6,1]
[,1] [,2] [,3] [,4] [,5] [,6]
[1,] 0.8235294 0.8225490 0.8127451 0.7823529 0.7833333 0.7980392
[2,] 0.8137255 0.7970588 0.7843137 0.7656863 0.7156863 0.7882353
[3,] 0.8196078 0.7460784 0.7833333 0.7725490 0.8196078 0.8343137
[4,] 0.7872549 0.8362745 0.8764706 0.8313725 0.8843137 0.8382353
[5,] 0.7921569 0.8725490 0.8980392 0.8500000 0.8784314 0.8774510
plot(ims)

# reshape image into a data frame
df = data.frame(
red = matrix(ims[,,1], ncol=1),
green = matrix(ims[,,2], ncol=1),
blue = matrix(ims[,,3], ncol=1)
)
str(df)
'data.frame': 12288 obs. of 3 variables:
$ red : num 0.824 0.814 0.82 0.787 0.792 ...
$ green: num 0.801 0.785 0.768 0.725 0.696 ...
$ blue : num 0.788 0.799 0.775 0.773 0.759 ...
Unsupervised Possibilistic Fuzzy C-Means algorithm
## this run takes a lot of time even I reduce the size of image by 4
res.pfcm <- ppclust::pfcm(df, centers=5)
# a numeric matrix containing the typicality degrees of the data objects.
# head(res.pfcm$t)
# Cluster 1 Cluster 2 Cluster 3 Cluster 4 Cluster 5
# 1 0.1288446 0.02401000 0.5443269 0.04291962 0.02055977
# 2 0.1372704 0.02475138 0.5163443 0.04446920 0.02134524
# 3 0.1778028 0.02888067 0.6170897 0.05291714 0.02388038
# 4 0.2379715 0.03496650 0.3370548 0.06518729 0.02919441
# 5 0.3363520 0.04244848 0.2810300 0.08164521 0.03373603
# 6 0.2753612 0.04541603 0.1528285 0.08426691 0.03965113
# a numeric matrix containing the distances of objects to the final cluster proto- types
# head(res.pfcm$d)
# Cluster 1 Cluster 2 Cluster 3 Cluster 4 Cluster 5
# 1 0.04158602 0.14948141 0.003761511 0.11366701 0.2243028
# 2 0.03865589 0.14489382 0.004208872 0.10952852 0.2158755
# 3 0.02844168 0.12365149 0.002788159 0.09122913 0.1924584
# 4 0.01969538 0.10149022 0.008837837 0.07309768 0.1565697
# 5 0.01213561 0.08295336 0.011495473 0.05733525 0.1348580
# 6 0.01618590 0.07729278 0.024907817 0.05539285 0.1140377
# a numeric vector containing the cluster labels found by defuzzifying the typicality degrees of the objects.
res.pfcm$cluster[1:20]
# 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
# 3 3 3 3 1 1 1 1 3 1 1 4 4 4 4 4 2 2 5 5
#unique(res.pfcm$cluster)
#[1] 3 1 4 2 5
# a numeric vector for the number of objects in the clusters.
# res.pfcm$csize
# 1 2 3 4 5
# 2892 2028 2610 2174 2584

Partitioning Cluster Analysis Using Fuzzy C-Means
im <- readImage("basales.jpg")
dim(im)
[1] 1024 768 3
# II. scale by 50%; the height is determined automatically so that
# the aspect ratio is preserved
ims <- resize(im, dim(im)[1]/8)
plot(ims)

# reshape image into a data frame
df = data.frame(
red = matrix(ims[,,1], ncol=1),
green = matrix(ims[,,2], ncol=1),
blue = matrix(ims[,,3], ncol=1)
)
str(res.fcm)
List of 17
$ u : num [1:12288, 1:5] 0.126 0.173 0.234 0.541 0.726 ...
..- attr(*, "dimnames")=List of 2
.. ..$ : chr [1:12288] "1" "2" "3" "4" ...
.. ..$ : chr [1:5] "Cluster 1" "Cluster 2" "Cluster 3" "Cluster 4" ...
$ v : num [1:5, 1:3] 0.837 0.879 0.677 0.818 0.839 ...
..- attr(*, "dimnames")=List of 2
.. ..$ : chr [1:5] "Cluster 1" "Cluster 2" "Cluster 3" "Cluster 4" ...
.. ..$ : chr [1:3] "red" "green" "blue"
$ v0 : num [1:5, 1:3] 0.719 0.908 0.72 0.839 0.776 ...
..- attr(*, "dimnames")=List of 2
.. ..$ : chr [1:5] "Cluster 1" "Cluster 2" "Cluster 3" "Cluster 4" ...
.. ..$ : chr [1:3] "red" "green" "blue"
$ d : num [1:12288, 1:5] 0.02124 0.01897 0.0122 0.00741 0.00357 ...
..- attr(*, "dimnames")=List of 2
.. ..$ : chr [1:12288] "1" "2" "3" "4" ...
.. ..$ : chr [1:5] "Cluster 1" "Cluster 2" "Cluster 3" "Cluster 4" ...
$ x : num [1:12288, 1:3] 0.824 0.814 0.82 0.787 0.792 ...
..- attr(*, "dimnames")=List of 2
.. ..$ : chr [1:12288] "1" "2" "3" "4" ...
.. ..$ : chr [1:3] "red" "green" "blue"
$ cluster : Named int [1:12288] 2 2 2 1 1 1 1 1 1 1 ...
..- attr(*, "names")= chr [1:12288] "1" "2" "3" "4" ...
$ csize : Named num [1:5] 2378 2062 2382 3032 2434
..- attr(*, "names")= chr [1:5] "1" "2" "3" "4" ...
$ sumsqrs :List of 4
..$ between.ss : num 372
..$ within.ss : Named num [1:5] 16.28 8.79 18.12 8.58 11.8
.. ..- attr(*, "names")= chr [1:5] "1" "2" "3" "4" ...
..$ tot.within.ss: num 63.6
..$ tot.ss : num 436
$ k : num 5
$ m : num 2
$ iter : num 107
$ best.start: int 1
$ func.val : num 34.5
$ comp.time : num 177
$ inpargs :List of 8
..$ iter.max: int 1000
..$ con.val : num 1e-09
..$ dmetric : chr "sqeuclidean"
..$ alginitv: chr "kmpp"
..$ alginitu: chr "imembrand"
..$ fixcent : logi FALSE
..$ fixmemb : logi FALSE
..$ stand : logi FALSE
$ algorithm : chr "FCM"
$ call : language ppclust::fcm(x = df, centers = 5)
- attr(*, "class")= chr "ppclust"
LS0tCnRpdGxlOiAiRnV6enkgYy1tZWFucyBjbHVzdGVyaW5nIgpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sKLS0tClVubGlrZSBLLW1lYW5zIGFsZ29yaXRobSwgZWFjaCBkYXRhIG9iamVjdCBpcyBub3QgdGhlIG1lbWJlciBvZiBvbmx5IG9uZSBjbHVzdGVyIGJ1dCBpcyB0aGUgbWVtYmVyIG9mIGFsbCBjbHVzdGVycyB3aXRoIHZhcnlpbmcgZGVncmVlcyBvZiBtZW1iZXJoaXAgYmV0d2VlbiAwIGFuZCAxLgoKSW4gb3VyIGNhc2UgLCBlYWNoIGRhdGEgb2JqZWN0IGJlbG9uZyB0byBPTkxZIG9uZSBjZWxsdWxhciBjb21wb25lbnQgbnVjbGVhciwgY3l0b3BsYXNtIG9yIG1lbWJyYW5lLiAKCkNvbmNsdXNpb246IAoxIC0gZmNtIGFuZCBwZmNtIHRha2VzIGEgbG90IG9mIHRpbWUgaWYgd2UgdXNlIGhpZ2ggaW1hZ2UgcmVzb2x1dGlvbgoyIC0gay1tZWFucyBtZXRob2Qgc2VlbXMgdG8gYmUgbW9yZSBzdWl0YWJsZS4KCmBgYHtyIGluY2x1ZGU9RkFMU0V9CiNzb3VyY2UoImh0dHA6Ly9iaW9jb25kdWN0b3Iub3JnL2Jpb2NMaXRlLlIiKQojYmlvY0xpdGUoIkVCSW1hZ2UiKQpsaWJyYXJ5KCJFQkltYWdlIikKYGBgCgoKYGBge3J9CmltIDwtIHJlYWRJbWFnZSgiYmFzYWxlcy5qcGciKQpkaW0oaW0pCnBsb3QoaW0pICMgcmFzdGVyIG1ldGhvZCBtZWFucyB3aXRoaW4gUgoKIyMgIEkuIHJlZHVjZSB0aGUgc2l6ZSBvZiBpbWFnZSAKIyBzY2FsZSB0byBhIHNwZWNpZmljIHdpZHRoIGFuZCBoZWlnaHQKICAgI2ltcyA8LSByZXNpemUoaW0sIHcgPSAyMDAsIGggPSAxMDApCgojIElJLiBzY2FsZSBieSA1MCU7IHRoZSBoZWlnaHQgaXMgZGV0ZXJtaW5lZCBhdXRvbWF0aWNhbGx5IHNvIHRoYXQKIyB0aGUgYXNwZWN0IHJhdGlvIGlzIHByZXNlcnZlZAppbXMgPC0gcmVzaXplKGltLCBkaW0oaW0pWzFdLzgpCmltcwpwbG90KGltcykKYGBgCgpgYGB7cn0KIyByZXNoYXBlIGltYWdlIGludG8gYSBkYXRhIGZyYW1lCmRmID0gZGF0YS5mcmFtZSgKICByZWQgPSBtYXRyaXgoaW1zWywsMV0sIG5jb2w9MSksCiAgZ3JlZW4gPSBtYXRyaXgoaW1zWywsMl0sIG5jb2w9MSksCiAgYmx1ZSA9IG1hdHJpeChpbXNbLCwzXSwgbmNvbD0xKQopCnN0cihkZikKYGBgCgoKYGBge3IgaW5jbHVkZT1GQUxTRX0KbGlicmFyeShwcGNsdXN0KQpgYGAKCiMjIFVuc3VwZXJ2aXNlZCBQb3NzaWJpbGlzdGljIEZ1enp5IEMtTWVhbnMgYWxnb3JpdGhtCmBgYHtyfQojIFBvc3NpYmlsaXN0aWMgRnV6enkgQy1NZWFucyBDbHVzdGVyaW5nIEFsZ29yaXRobQojIyB0aGlzIHJ1biB0YWtlcyBhIGxvdCBvZiB0aW1lIGV2ZW4gSSByZWR1Y2UgdGhlIHNpemUgb2YgaW1hZ2UgYnkgNAojIHJlcy5wZmNtIDwtIHBwY2x1c3Q6OnBmY20oZGYsIGNlbnRlcnM9NSkKIyBhIG51bWVyaWMgbWF0cml4IGNvbnRhaW5pbmcgdGhlIGZpbmFsIGNsdXN0ZXIgcHJvdG90eXBlcy4KcmVzLnBmY20kdgojICAgICAgICAgICAgICAgICByZWQgICAgIGdyZWVuICAgICAgYmx1ZQojIENsdXN0ZXIgMSAwLjg0MjA2MTMgMC42MTkxNzMyIDAuNjk3NzQzNwojIENsdXN0ZXIgMiAwLjgxODI5MzQgMC40ODc2ODk4IDAuNTYxNzMzNwojIENsdXN0ZXIgMyAwLjg3MjA1NDkgMC43NjQ0NTAyIDAuNzc5NzMwMAojIENsdXN0ZXIgNCAwLjgzNTU5MDMgMC41MTk1NTE0IDAuNjAyOTgwNwojIENsdXN0ZXIgNSAwLjY5MjcyMzggMC40MjQwNTc0IDAuNTMzMDQ1NgpgYGAKCmBgYHtyfQojIGEgbnVtZXJpYyBtYXRyaXggY29udGFpbmluZyB0aGUgdHlwaWNhbGl0eSBkZWdyZWVzIG9mIHRoZSBkYXRhIG9iamVjdHMuCiMgaGVhZChyZXMucGZjbSR0KQojICAgQ2x1c3RlciAxICBDbHVzdGVyIDIgQ2x1c3RlciAzICBDbHVzdGVyIDQgIENsdXN0ZXIgNQojIDEgMC4xMjg4NDQ2IDAuMDI0MDEwMDAgMC41NDQzMjY5IDAuMDQyOTE5NjIgMC4wMjA1NTk3NwojIDIgMC4xMzcyNzA0IDAuMDI0NzUxMzggMC41MTYzNDQzIDAuMDQ0NDY5MjAgMC4wMjEzNDUyNAojIDMgMC4xNzc4MDI4IDAuMDI4ODgwNjcgMC42MTcwODk3IDAuMDUyOTE3MTQgMC4wMjM4ODAzOAojIDQgMC4yMzc5NzE1IDAuMDM0OTY2NTAgMC4zMzcwNTQ4IDAuMDY1MTg3MjkgMC4wMjkxOTQ0MQojIDUgMC4zMzYzNTIwIDAuMDQyNDQ4NDggMC4yODEwMzAwIDAuMDgxNjQ1MjEgMC4wMzM3MzYwMwojIDYgMC4yNzUzNjEyIDAuMDQ1NDE2MDMgMC4xNTI4Mjg1IDAuMDg0MjY2OTEgMC4wMzk2NTExMwpgYGAKCmBgYHtyfQojIGEgbnVtZXJpYyBtYXRyaXggY29udGFpbmluZyB0aGUgZGlzdGFuY2VzIG9mIG9iamVjdHMgdG8gdGhlIGZpbmFsIGNsdXN0ZXIgcHJvdG8tIHR5cGVzCiMgaGVhZChyZXMucGZjbSRkKQojICBDbHVzdGVyIDEgIENsdXN0ZXIgMiAgIENsdXN0ZXIgMyAgQ2x1c3RlciA0IENsdXN0ZXIgNQojIDEgMC4wNDE1ODYwMiAwLjE0OTQ4MTQxIDAuMDAzNzYxNTExIDAuMTEzNjY3MDEgMC4yMjQzMDI4CiMgMiAwLjAzODY1NTg5IDAuMTQ0ODkzODIgMC4wMDQyMDg4NzIgMC4xMDk1Mjg1MiAwLjIxNTg3NTUKIyAzIDAuMDI4NDQxNjggMC4xMjM2NTE0OSAwLjAwMjc4ODE1OSAwLjA5MTIyOTEzIDAuMTkyNDU4NAojIDQgMC4wMTk2OTUzOCAwLjEwMTQ5MDIyIDAuMDA4ODM3ODM3IDAuMDczMDk3NjggMC4xNTY1Njk3CiMgNSAwLjAxMjEzNTYxIDAuMDgyOTUzMzYgMC4wMTE0OTU0NzMgMC4wNTczMzUyNSAwLjEzNDg1ODAKIyA2IDAuMDE2MTg1OTAgMC4wNzcyOTI3OCAwLjAyNDkwNzgxNyAwLjA1NTM5Mjg1IDAuMTE0MDM3NwpgYGAKCgpgYGB7cn0KIyBhIG51bWVyaWMgdmVjdG9yIGNvbnRhaW5pbmcgdGhlIGNsdXN0ZXIgbGFiZWxzIGZvdW5kIGJ5IGRlZnV6emlmeWluZyB0aGUgdHlwaWNhbGl0eSBkZWdyZWVzIG9mIHRoZSBvYmplY3RzLgpyZXMucGZjbSRjbHVzdGVyWzE6MjBdCiMgMSAgMiAgMyAgNCAgNSAgNiAgNyAgOCAgOSAxMCAxMSAxMiAxMyAxNCAxNSAxNiAxNyAxOCAxOSAyMCAKIyAzICAzICAzICAzICAxICAxICAxICAxICAzICAxICAxICA0ICA0ICA0ICA0ICA0ICAyICAyICA1ICA1IAojdW5pcXVlKHJlcy5wZmNtJGNsdXN0ZXIpCiNbMV0gMyAxIDQgMiA1CmBgYAoKCmBgYHtyfQojIGEgbnVtZXJpYyB2ZWN0b3IgZm9yIHRoZSBudW1iZXIgb2Ygb2JqZWN0cyBpbiB0aGUgY2x1c3RlcnMuCiMgcmVzLnBmY20kY3NpemUKIyAgIDEgICAgMiAgICAzICAgIDQgICAgNSAKIyAyODkyIDIwMjggMjYxMCAyMTc0IDI1ODQKYGBgCgoKYGBge3J9CmRmJGxhYmVsID0gcmVzLnBmY20kY2x1c3RlcgogIAogICMjIyBSZXBsYWNlIHRoZSBjb2xvciBvZiBlYWNoIHBpeGVsIGluIHRoZSBpbWFnZSB3aXRoIHRoZSBtZWFuIAogICMjIyBSLEcsIGFuZCBCIHZhbHVlcyBvZiB0aGUgY2x1c3RlciBpbiB3aGljaCB0aGUgcGl4ZWwgcmVzaWRlczoKICAKICAjIGdldCB0aGUgY29sb3JpbmcKICBjb2xvcnMgPSBkYXRhLmZyYW1lKAogICAgbGFiZWwgPSAxOm5yb3coSyRjZW50ZXJzKSwgCiAgICBSID0gcmVzLnBmY20kdlssInJlZCJdLAogICAgRyA9IHJlcy5wZmNtJHZbLCJncmVlbiJdLAogICAgQiA9IHJlcy5wZmNtJHZbLCJibHVlIl0KICApCiAgCiAgIyBtZXJnZSBjb2xvciBjb2RlcyBvbiB0byBkZgogICMgSU1QT1JUQU5UOiB3ZSBtdXN0IG1haW50YWluIHRoZSBvcmlnaW5hbCBvcmRlciBvZiB0aGUgZGYgYWZ0ZXIgdGhlIG1lcmdlIQogIAogIGRmJG9yZGVyIDwtIDE6bnJvdyhkZikKICBkZiA8LSBtZXJnZShkZiwgY29sb3JzKQogIAogIAogICMgcmVvcmRlciB0aGUgbWF0cml4IChpbWFnZSkKICAgIGRmIDwtIGRmW29yZGVyKGRmJG9yZGVyKSxdCiAgICBkZiRvcmRlciA9IE5VTEwKICAgIAogICAgIyBnZXQgbWVhbiBjb2xvciBjaGFubmVsIHZhbHVlcyBmb3IgZWFjaCByb3cgb2YgdGhlIGRmLgogICAgUiA8LSBtYXRyaXgoZGYkUiwgbnJvdz1kaW0oaW1zKVsxXSkKICAgIEcgPC0gbWF0cml4KGRmJEcsIG5yb3c9ZGltKGltcylbMV0pCiAgICBCIDwtIG1hdHJpeChkZiRCLCBucm93PWRpbShpbXMpWzFdKQogICAgCiAgICAjIHJlY29uc3RpdHV0ZSB0aGUgc2VnbWVudGVkIGltYWdlIGluIHRoZSBzYW1lIHNoYXBlIGFzIHRoZSBpbnB1dCBpbWFnZQogICAgaW0uc2VnbWVudGVkIDwtIGFycmF5KGRpbT1kaW0oaW1zKSkKICAgIGltLnNlZ21lbnRlZFssLDFdID0gUgogICAgaW0uc2VnbWVudGVkWywsMl0gPSBHCiAgICBpbS5zZWdtZW50ZWRbLCwzXSA9IEIKICAgIAogICAgaW0uc2VnbWVudGVkIDwtIEVCSW1hZ2U6OkltYWdlKGltLnNlZ21lbnRlZCwgY29sb3Jtb2RlPUNvbG9yKQogICAgCiAgICBwbG90KGltLnNlZ21lbnRlZCkKYGBgCgoKCgojIFBhcnRpdGlvbmluZyBDbHVzdGVyIEFuYWx5c2lzIFVzaW5nIEZ1enp5IEMtTWVhbnMKCmBgYHtyfQppbSA8LSByZWFkSW1hZ2UoImJhc2FsZXMuanBnIikKZGltKGltKQojIElJLiBzY2FsZSBieSA1MCU7IHRoZSBoZWlnaHQgaXMgZGV0ZXJtaW5lZCBhdXRvbWF0aWNhbGx5IHNvIHRoYXQKIyB0aGUgYXNwZWN0IHJhdGlvIGlzIHByZXNlcnZlZAppbXMgPC0gcmVzaXplKGltLCBkaW0oaW0pWzFdLzgpCnBsb3QoaW1zKQpgYGAKCmBgYHtyfQojIHJlc2hhcGUgaW1hZ2UgaW50byBhIGRhdGEgZnJhbWUKZGYgPSBkYXRhLmZyYW1lKAogIHJlZCA9IG1hdHJpeChpbXNbLCwxXSwgbmNvbD0xKSwKICBncmVlbiA9IG1hdHJpeChpbXNbLCwyXSwgbmNvbD0xKSwKICBibHVlID0gbWF0cml4KGltc1ssLDNdLCBuY29sPTEpCikKYGBgCgpgYGB7cn0KcmVzLmZjbSA8LSBwcGNsdXN0OjpmY20oZGYsIGNlbnRlcnMgPSA1KQpzdHIocmVzLmZjbSkKYGBgCgo=